subroutine mc(ss,x,y,E2)
use var
use type
use parallel
implicit none
include 'mpif.h'
integer x, ii, iout, tt, ss, y
real(dp) :: delta, delta2, dmc_cur, temp_cur
real(dp) :: E1, E2, DE, ac, dt_cur, energy(3), max_ac
real(dp),dimension(:), allocatable :: cur_energy
logical :: flag = .true.

allocate(gEnergy(tnodes))
call g_Energy()

if (ID == Master) then
   allocate(cur_energy(3*size))
endif
iout = 300 + ID + 1

delta = (log(temp(2)) - log(temp(1)))/temp(3)
delta2= (dmc(2)-dmc(1))/dmc(3)
if (x/=0) then
     temp_cur = exp(log(temp(1)) + delta*(x-y))
     dmc_cur  = dmc(1) + delta2*(x-y)
     if (x>temp(3)) temp_cur = temp(2)
     if (x>dmc(3))  dmc_cur = dmc(2)
     call mcmoves(1/temp_cur,dmc_cur)
     x = x + 1
endif

E1 = 0
ac = 1
max_ac = 1
tt = 1
flag = .true.

Do while (flag)
  
  if (mod(x,sample)==0) then
     call free_energy(energy)
     E2 = energy(3)
     DE = (E1-E2)
     ac = abs(DE/E1)*100
     E1 = E2
     temp_cur = exp(log(temp(1)) + delta*x)
     dmc_cur  = dmc(1) + delta2*x
     if (x>temp(3)) temp_cur = temp(2)
     if (x>dmc(3))  dmc_cur = dmc(2)

     write(iout,'(I7,X,3(f15.6))')x,energy
     CALL MPI_BARRIER(MPI_COMM_WORLD, IERR) 
     CALL MPI_ALLREDUCE (ac, max_ac, 1, MPI_DOUBLE_PRECISION, MPI_MAX,MPI_COMM_WORLD, IERR)
     CALL MPI_GATHER(energy,3,MPI_DOUBLE_PRECISION,cur_energy,3,MPI_DOUBLE_PRECISION,master,MPI_COMM_WORLD,ierr)
     if (ID == Master) then
        open (22, file = 'timestep')
        Do ii=1,size
           write(22,'(2I7,X,3(f15.6))')ii,x,cur_energy(1+(ii-1)*3:ii*3)
        enddo
        close(22)
     endif
     trj_E(:,tt) = energy
     tt = tt+1
     if (max_ac < accuracy(1)) flag = .false.
  endif
  
  if (mod(x,traj(1))==0) then
       if (ID == Master) then
         Do ii=1,size
            write(222,'(2I7,X,3(f15.6))')ii,x,cur_energy(1+(ii-1)*3:ii*3)
            write(*,'(2I7,X,3(f15.6))')ii,x,cur_energy(1+(ii-1)*3:ii*3)
         enddo
      endif
     if (traj(2)==1) call wtraj(ss,x,y)
     tt = 1
  endif

  call mcmoves(1/temp_cur,dmc_cur)
  x = x + 1
enddo
contains
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine  g_Energy()
use type
use var
implicit none
integer :: label
real(dp) :: ldg_energy 

Do label = 1,tnodes
   gEnergy(label) = LdG_Energy(q(:,label))
enddo

return
end subroutine g_Energy


endsubroutine mc
